;; Gridgame with Scheme2js - 2006/09/07
;; Copyright (c) 2006 Teruaki Gemma
;; Licensed under the GPL

;;Constants
(define width 18)
(define height 18)
(define grid '())
(define anim-grid '())
(define data-colors (vector "#2ca9e1" "#4d5aaf" "#867ba9" "#dbd0e6"))
(define timer 0)
(define effect-proc 0)

(define (start-game mode)
  (set! grid (make-grid height width))
  (set! anim-grid (make-grid height width))
  (for-each-yx 
   (lambda (y x)
     (case mode
       ((0) (cell-set! grid y x (random-int 4)))
       ((1) (cell-set! grid y x 0))
       ((2) (cell-set! grid y x (modulo y 4)))
       ((3) (cell-set! grid y x (modulo (+ y x) 4))))
     (set-html-cell-color! y x (cell-ref grid y x))
     (let ((el (html-cell y x)))
       (el.setOpacity 1)
       (el.show))
     (Event.observe (html-cell y x) "click" (lambda () (propagete y x 1)) #f))
   height width)
  (window.clearInterval timer)
  (set! timer (window.setInterval update 50)))

(define (update)
  (for-each-yx 
   (lambda (y x)
     (let ((val (cell-ref anim-grid y x)))
       (cond	
	 ((> val 0)
	  (cell-set! anim-grid y x (- val 2)))
	 ((< val 0)
	  (set-html-cell-color! y x (cell-ref grid y x))
	  (js-new effect-proc (html-cell y x))
	  (cell-set! anim-grid y x 0)))))
   height width))

(define (propagete y x delay)
  (define (prop-case cy cx lis)
    (if (valid-coord? cy cx)
	(if (pair? (memq (cell-ref grid cy cx) lis))
	    (propagete cy cx (+ delay 2)))))

  (let ((val (modulo (+ (cell-ref grid y x) 1) 4)))
    (cell-set! grid y x val)
    (cell-set! anim-grid y x delay)
    (case val
      ((0)
       (prop-case (- y 1) x (list 1 2))
       (prop-case y (+ x 1) (list 2 3)))
      ((1)
       (prop-case (+ y 1) x (list 0 3))
       (prop-case y (+ x 1) (list 2 3)))
      ((2)
       (prop-case (+ y 1) x (list 0 3))
       (prop-case y (- x 1) (list 0 1)))
      ((3)
       (prop-case (- y 1) x (list 1 2))
       (prop-case y (- x 1) (list 0 1))))))

(define (html-cell y x)
  (document.getElementById (+ "grid-" y "-" x)))

(define (set-html-cell-color! y x col)
  (let ((el (html-cell y x)))
    (set! el.style.background (vector-ref data-colors col))))

(define (select-effect! n)
  (set! effect-proc 
	(case n
	  ((0) Effect.Highlight)
	  ((1) Effect.Fade)
	  ((2) Effect.Appear)
	  ((3) Effect.Puff)
	  ((4) Effect.BlindUp)
	  ((5) Effect.BlindDown)
	  ((6) Effect.SwitchOff)
	  ((7) Effect.DropOut)
	  ((8) Effect.Shake)
	  ((9) Effect.SlideDown)
	  ((10) Effect.SlideUp)
	  ((11) Effect.Squish)
	  ((12) Effect.Grow)
	  ((13) Effect.Shrink)
	  ((14) Effect.Pulsate)
	  ((15) Effect.Fold))))

(define (valid-coord? y x)
  (and
   (>= y 0)
   (< y height)
   (>= x 0)
   (< x width)))

(define (make-grid h w)
  (list->vector (map (lambda (l) (make-vector w 0)) (make-list h))))

(define (cell-set! gr y x val)
  (vector-set! (vector-ref gr y) x val))

(define (cell-ref gr y x)
  (vector-ref (vector-ref gr y) x))

(define (for-each-yx fun h w) 
  (let loop0 ((y 0))
    (if (< y h)
	(begin
	  (let loop1 ((x 0))
	    (if (< x w)
		(begin
		  (fun y x)
		  (loop1 (+ x 1)))))
	  (loop0 (+ y 1))))))

(define (random-int n)
  (Math.floor (* (Math.random) n)))
